home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO090.dsk / Z.LINK.EDIT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  10KB  |  273 lines
  1. 0  REM  /z.link.edit
  2. 1 PN$ = "z.link.edit"
  3. 99 :
  4. 100  REM  *************************************
  5. 105  REM  *
  6. 110  REM  * Z-Link key remappings editor
  7. 120  REM  *
  8. 130  REM  * by David A. Lyons, 11-Apr-88
  9. 140  REM  * (public domain...have fun)
  10. 150  REM  *
  11. 155  REM  *************************************
  12. 156 :
  13. 157  REM  * Force run at $2000 (not $800)
  14. 160  IF  PEEK(104) = 32  THEN 200
  15. 170  POKE 104,32: POKE 103,1: POKE 256 *32,0
  16. 180  PRINT  CHR$(4);"run ";PN$
  17. 190 :
  18. 200  TEXT : HOME : NORMAL : SPEED= 255: NOTRACE 
  19. 205  PRINT  CHR$(4);"pr#3": PRINT 
  20. 210 :
  21. 220  REM  * check for IIgs
  22. 230  POKE 768,56: POKE 769,32: POKE 770,31: POKE 771,254: POKE 772,169: POKE 773,0: POKE 774,42: POKE 775,133: POKE 776,0: POKE 777,96: POKE 778,173: POKE 779,37: POKE 780,192: POKE 781,133: POKE 782,0: POKE 783,173: POKE 784,97: POKE 785,192: POKE 786,41: POKE 787,128
  23. 232  POKE 788,5: POKE 789,0: POKE 790,133: POKE 791,0: POKE 792,173: POKE 793,98: POKE 794,192: POKE 795,41: POKE 796,128: POKE 797,106: POKE 798,5: POKE 799,0: POKE 800,41: POKE 801,211: POKE 802,133: POKE 803,0: POKE 804,96
  24. 240  CALL 768:GS = ( PEEK(0) = 0)
  25. 300 :
  26. 310 DF$ = "z.link.config"
  27. 320  GOSUB 2000: REM  * build command table
  28. 330 DIRTY = 0: REM  * "dirty" = need to save file
  29. 340 LD = 0: REM  * "ld" = loaded a config file
  30. 399 :
  31. 405 ADR = 2048
  32. 500  REM  * calculate locations within file
  33. 510 KT = ADR + PEEK(ADR +11) + PEEK(ADR +12) *256: REM  * Key Table
  34. 520 MT = KT +256: REM  * Modifier Table
  35. 530 DT = MT +256: REM  * Definition Table
  36. 999 :
  37. 1000  REM  * main menu
  38. 1005  HOME : PRINT 
  39. 1010  PRINT "============================"
  40. 1020  PRINT "Z-Link Key Remappings Editor"
  41. 1030  PRINT 
  42. 1040  PRINT "David A. Lyons     11-Apr-88"
  43. 1045  PRINT "Last Modification:  2-Jun-88"
  44. 1050  PRINT "============================"
  45. 1060  PRINT 
  46. 1100  FOR I = 1 TO  LEN(CMD$)
  47. 1110  PRINT "  "; LEFT$(CMD$(I),1);". ";CMD$(I)
  48. 1120  NEXT I
  49. 1190  PRINT 
  50. 1200  PRINT "Select: ";
  51. 1205 :
  52. 1209  REM  Get a key & make it uppercase
  53. 1210  GET A$: IF A$ > = "a"  THEN A$ =  CHR$( ASC(A$) -32)
  54. 1215  FOR I = 1 TO  LEN(CMD$)
  55. 1216  IF A$ =  MID$ (CMD$,I,1)  THEN CMD = I:I = 100: NEXT I: GOTO 1300
  56. 1220  NEXT I: PRINT  CHR$(7);: GOTO 1210
  57. 1300  REM  * command number CMD
  58. 1310  HOME 
  59. 1350 C$ = "- " +CMD$(CMD) +" -": GOSUB 63000: PRINT 
  60. 1400  ON CMD GOSUB 11000,12000,13000,14000,15000,16000,17000,18000
  61. 1410  GOTO 405
  62. 1999 :
  63. 2000  REM  * Build CMD$, CMD$()
  64. 2010 CMD$ = ""
  65. 2020  READ A$: IF A$ = "***"  THEN 2100
  66. 2025 CMD$ = CMD$ + LEFT$(A$,1)
  67. 2030 CMD$( LEN(CMD$)) = A$
  68. 2040  GOTO 2020
  69. 2100  RETURN 
  70. 2500  DATA  Load config file, Save config file, View remappings
  71. 2510  DATA  Delete a remapping,Make a new remapping
  72. 2520  DATA  Quit (to BASIC)
  73. 2530  DATA  Bye
  74. 2540  DATA  ***
  75. 2999 :
  76. 3000  REM  * Didn't load any config file yet
  77. 3005  VTAB 8
  78. 3010  PRINT : PRINT "You need to L)oad a config file first."
  79. 3020  VTAB 22: GOTO 60000
  80. 3030 :
  81. 3100  REM   * Dirty; continue anyway?
  82. 3110  IF   NOT DIRTY  THEN  RETURN 
  83. 3115  VTAB 8
  84. 3120  PRINT : PRINT "Okay to lose changes";
  85. 3130  GOSUB 57000
  86. 3140  IF Y  THEN  RETURN 
  87. 3150  POP : RETURN 
  88. 3160 :
  89. 5000  REM  * Get the Ith definition
  90. 5010  REM  * returns K,M=key,modifiers
  91. 5020  REM  * returns K$,M$ = printable key,modifiers
  92. 5030  REM  * returns D$ = printable definition
  93. 5040  REM  * returns D = address of definition
  94. 5100 K =  PEEK(KT +I): GOSUB 6500
  95. 5130 M =  PEEK(MT +I):M2 = M: GOSUB 6000
  96. 5220  GOSUB 7000
  97. 5500  RETURN 
  98. 5999 :
  99. 6000  REM   * return M$=name for modifier combination M2
  100. 6005 M$ = ""
  101. 6010  IF M2 >127  THEN M2 = M2 -128:M$ = M$ +"OA-"
  102. 6020  IF M2 >63  THEN M2 = M2 -64:M$ = M$ +"CA-"
  103. 6030  IF M2 >31  THEN M2 = M2 -32: REM   * updated mod latch...
  104. 6040  IF M2 >15  THEN M2 = M2 -16:M$ = M$ +"KP-"
  105. 6050  IF M2 >7  THEN M2 = M2 -8:M$ = M$ +"Ignore-"
  106. 6060  IF M2 >3  THEN M2 = M2 = 4:M$ = M$ +"CapsLock-"
  107. 6070  IF M2 >1  THEN M2 = M2 -2:M$ = M$ +"Control-"
  108. 6080  IF M2 >0  THEN M2 = M2 -1:M$ = M$ +"Shift-"
  109. 6090  RETURN 
  110. 6095 :
  111. 6500  REM  * Return K$ = printable name for key K
  112. 6510 KK = K: IF KK >127  THEN KK = KK -128
  113. 6520 K$ =  CHR$(KK): IF KK = 127  THEN K$ = "Delete"
  114. 6530  IF KK <32  THEN K$ = "^" + CHR$(KK +64)
  115. 6540  IF KK = 13  THEN K$ = "cr": RETURN 
  116. 6550  IF KK = 27  THEN K$ = "Esc": RETURN 
  117. 6560  IF KK = 8  THEN K$ = "Backsp": RETURN 
  118. 6562  IF KK = 21  THEN K$ = "Forwsp": RETURN 
  119. 6564  IF KK = 10  THEN K$ = "Downarr": RETURN 
  120. 6566  IF KK = 11  THEN K$ = "Uparr": RETURN 
  121. 6570  IF KK = 9  THEN K$ = "Tab": RETURN 
  122. 6580  IF KK = 32  THEN K$ = "Space": RETURN 
  123. 6950  RETURN 
  124. 6960 :
  125. 7000  REM  * return D=address of Ith definition, D$=printable version
  126. 7010 D = DT:I2 = I
  127. 7020  IF I2 = 0  THEN 7500: REM   * while i2>0 do...
  128. 7030  IF  PEEK(D) + PEEK(D +1) < >0  THEN D = D +2: GOTO 7030
  129. 7040 D = D +2
  130. 7050 I2 = I2 -1: GOTO 7020
  131. 7100 :
  132. 7500  REM   * build printable version (D$) of def at D
  133. 7510 D2 = D:D$ = ""
  134. 7515 K9 = K:M9 = M:K9$ = K$:M9$ = M$
  135. 7520  IF  PEEK(D2) + PEEK(D2 +1) = 0  THEN 7900
  136. 7530 M2 =  PEEK(D2): GOSUB 6000
  137. 7540 K =  PEEK(D2 +1): GOSUB 6500
  138. 7550 D$ = D$ +M$ +K$ +" "
  139. 7560 D2 = D2 +2: GOTO 7520
  140. 7900 K = K9:M = M9:K$ = K9$:M$ = M9$: RETURN 
  141. 7999 :
  142. 8000  REM  * get a keypress --> K,M
  143. 8010  INVERSE : PRINT " "; CHR$(8);: NORMAL 
  144. 8020  WAIT  -16384,128
  145. 8030  IF   NOT GS  THEN 8040
  146. 8032  CALL 778:M =  PEEK(0): GOTO 8070
  147. 8040 M = 0: IF  PEEK( -16287) >127  THEN M = M +128
  148. 8050  IF  PEEK( -16286) >127  THEN M = M +64
  149. 8070  GET K$:K =  ASC(K$) +128: PRINT " "; CHR$(8);
  150. 8100  RETURN 
  151. 8999 :
  152. 9000  REM  * Search for remapping M,K --> return I (-1=not found)
  153. 9010 I = 0
  154. 9020  IF  PEEK(KT +I) = K  AND  PEEK(MT +I) = M  THEN  RETURN 
  155. 9030 I = I +1: IF I <256  THEN 9020
  156. 9040 I =  -1: RETURN 
  157. 9050 :
  158. 10999 :
  159. 11000  REM  * Load config file
  160. 11005  GOSUB 3100
  161. 11007  VTAB 8
  162. 11100 BS$ = "": FOR I = 1 TO  LEN(DF$):BS$ = BS$ + CHR$(8): NEXT 
  163. 11200  PRINT "Name of Z-Link config file: ";DF$;BS$;
  164. 11210  INPUT "";N$
  165. 11220  IF N$ = ""  THEN N$ = DF$
  166. 11225 DF$ = N$
  167. 11230  PRINT  CHR$(4);"bload ";N$;",tvar,a";ADR
  168. 11240 DIRTY = 0:LD = 1
  169. 11300  RETURN 
  170. 11999 :
  171. 12000  REM  * Save config file
  172. 12010  IF   NOT LD  THEN 3000
  173. 12090  PRINT  CHR$(4);"bsave ";N$;",tvar,a";ADR
  174. 12100 DIRTY = 0: RETURN 
  175. 12999 :
  176. 13000  REM  * View remappings
  177. 13010  IF   NOT LD  THEN 3000
  178. 13100  FOR I = 0 TO 255
  179. 13110  GOSUB 5000
  180. 13120  IF M +K = 0  THEN I = 256: GOTO 13200
  181. 13130  IF  LEN(M$ +K$) <15  THEN  PRINT  SPC( 15 - LEN(M$ +K$));
  182. 13135  PRINT M$;K$;" --> ";D$
  183. 13200  NEXT 
  184. 13210  GOTO 60000
  185. 13999 :
  186. 14000  REM  * Delete a remapping
  187. 14010  IF   NOT LD  THEN 3000
  188. 14015  VTAB 8
  189. 14020  PRINT "Delete which remapping: ";
  190. 14030  GOSUB 8000
  191. 14040 M2 = M: GOSUB 6000: GOSUB 6500: PRINT M$;K$
  192. 14045  PRINT : PRINT 
  193. 14050  GOSUB 9000: REM  * find remapping --> I
  194. 14060  IF I <0  THEN  PRINT "That key isn't defined.": GOTO 14500
  195. 14065 DIRTY = 1
  196. 14070  PRINT "Deleting...";
  197. 14072  FOR J = I TO 254: POKE KT +J, PEEK(KT +J +1)
  198. 14074  POKE MT +J, PEEK(MT +J +1): NEXT 
  199. 14076  POKE MT +255,0: POKE KT +255,0
  200. 14080  GOSUB 5000: REM  * D=address of def
  201. 14090 D2 = D
  202. 14100  IF  PEEK(D2) + PEEK(D2 +1) = 0  THEN 14115
  203. 14110 D2 = D2 +2: GOTO 14100
  204. 14115 D2 = D2 +2
  205. 14120 L = D2 -D
  206. 14130  FOR J = D TO DT +1023 -L: POKE J, PEEK(J +L): NEXT 
  207. 14140  FOR J = DT +1024 -L TO DT +1023: POKE J,0: NEXT 
  208. 14200  PRINT "done."
  209. 14500  VTAB 22: GOTO 60000
  210. 14999 :
  211. 15000  REM  * Make a new remapping
  212. 15010  IF   NOT LD  THEN 3000
  213. 15020  VTAB 8: PRINT "Key to remap: ";
  214. 15030  GOSUB 8000:M2 = M: GOSUB 6000: GOSUB 6500: IF M >127  THEN  PRINT "Open Apple-keys are reserved for internal Z-Link commands.": GOTO 15020
  215. 15040  PRINT M$;K$: PRINT : PRINT 
  216. 15050 I = 0
  217. 15060  IF  PEEK(KT +I) + PEEK(MT +I) = 0  THEN 15200
  218. 15070  IF  PEEK(KT +I) = K  AND  PEEK(MT +I) = M  THEN 15900
  219. 15080 I = I +1: IF I <256  THEN 15060
  220. 15090  PRINT "Too many remappings (max=256).": GOTO 60000
  221. 15199 :
  222. 15200  REM  * create definition #i
  223. 15202 DIRTY = 1
  224. 15205  PRINT "(Apple-Return = finish, Apple-Delete backs up, Apple-X to enter a literal)"
  225. 15207  PRINT : PRINT "Enter definition:": PRINT :V =  PEEK(37) +1
  226. 15210  GOSUB 7000: REM  * D = addr of definition
  227. 15220  POKE KT +I,K: POKE MT +I,M
  228. 15230 D2 = D
  229. 15299 :
  230. 15300  REM  * get next key
  231. 15310  GOSUB 8000
  232. 15315  IF M = 128  AND (K = 216  OR K = 248)  THEN  GOSUB 8000:M = M +8
  233. 15320  IF M = 128  AND (K = 255  OR K = 136)  THEN 15500
  234. 15330  IF M = 128  AND K = 141  THEN  VTAB 22: GOTO 60000
  235. 15340 M2 = M: GOSUB 6000: GOSUB 6500: PRINT M$;K$;" ";
  236. 15350  POKE D2,M: POKE D2 +1,K:D2 = D2 +2
  237. 15370  GOTO 15300
  238. 15499 :
  239. 15500  REM  * back up (Apple-Delete or Apple-Left)
  240. 15510  IF D2 = D  THEN  PRINT  CHR$(7);: GOTO 15300
  241. 15520  VTAB V -1: PRINT 
  242. 15530 D2 = D2 -2: POKE D2,0: POKE D2 +1,0
  243. 15535  IF D2 = D  THEN 15570
  244. 15540  FOR J = D TO D2 -2  STEP 2:M2 =  PEEK(J):K =  PEEK(J +1)
  245. 15550  GOSUB 6000: GOSUB 6500: PRINT M$;K$;" ";
  246. 15560  NEXT 
  247. 15570  PRINT  CHR$(11);: GOTO 15300
  248. 15899 :
  249. 15900  REM  * already defined
  250. 15910  PRINT "That key is already defined.": GOTO 60000
  251. 15999 :
  252. 16000  REM  * Quit to BASIC
  253. 16010  GOSUB 3100
  254. 16100  HOME : PRINT "Bye!": END 
  255. 16999 :
  256. 17000  REM  * BYE
  257. 17010  GOSUB 3100
  258. 17100  PRINT  CHR$(4);"BYE": STOP 
  259. 17999 :
  260. 56999 :
  261. 57000  REM  * Get Yes/No answer (Y=1 or 0)
  262. 57010  PRINT "? (y/n) ";
  263. 57020  GET A$: IF A$ = "y"  OR A$ = "Y"  THEN  PRINT "Yes":Y = 1: RETURN 
  264. 57030  IF A$ = "n"  OR A$ = "N"  THEN  PRINT "No":Y = 0: RETURN 
  265. 57040  PRINT  CHR$(7);: GOTO 57020
  266. 59999 :
  267. 60000  REM  * Get space to continue
  268. 60010  PRINT : PRINT "Press SPACE to continue ";
  269. 60020  GET A$: IF A$ < >" "  THEN 60020
  270. 60030  PRINT : RETURN 
  271. 62999 :
  272. 63000  REM  * Center C$
  273. 63010  HTAB 40 - LEN(C$)/2: PRINT C$: RETURN